package sybrevolutions

object forvalues {
  
  
  /*
   * Infrastructure
   */
  
  
  //contains function concrete => structural for datatype
  //specific for each datatype
  trait TypeMan[A]{  //kind: *=>*
    def toValSpine(a:A):ValSpine[A]
    //def toTypeSpines:List[TypeSpine[A]]
  }
  
  //generic view of constructor application to values
  
  //contains function structural => concrete for datatype: structural info is enough to to this
  sealed trait ValSpine[A] { //stages in constructing a value
    def buildFromSpine:A
  }
  type ConstrDesc = {val n:String}
  case class ConstrExt[A](a:A,desc:ConstrDesc) extends ValSpine[A] {
    def buildFromSpine = a
  }
  case class Apped[A,B](constred: ValSpine[A=>B] , a_ :Typed[A]) extends ValSpine[B] {
    def buildFromSpine = constred.buildFromSpine (a_._1)
  }
  
  
  implicit def Ty [A](a:A)(implicit at: TypeMan[A]):Typed[A] = Typed(a,at)
  case class Typed[A](value:A,typerep:TypeMan[A]) extends Tuple2[A,  TypeMan[A]](value,typerep)
  
  /*
   *small example functions
   */

  def arity[T](t:T)(implicit tman:TypeMan[T]):Int = arityprim(tman.toValSpine(t))
  def arityprim[T](sp:ValSpine[T]):Int = sp match {
    case ConstrExt(a,desc) => 0
    case Apped(f, Typed(x,t)) => arityprim(f)+1
  }
  
  
  def sum[A](ty:TypeMan[A], a:A):Int = { 
    def sumbis[B](s:ValSpine[B]):Int = s match {
      case ConstrExt(c,i) => 0
      case Apped(f, Typed(x,t)) => sumbis(f) + sum(t,x)
    }
    
    ty match {
    case IntMan => a
    case _    => sumbis (ty.toValSpine(a))
  }
  }
  
  
  
  /*
     * SYB in function of TypeMan
     */
    
    
    trait Query[R] {
      def apply[A](ty:TypeMan[A], a:A):R
    }
    
    def mapQ[R](q:Query[R]):Query[List[R]] = {
      trait SToRsQ { def apply[A](s:ValSpine[A]):List[R] }
      def mapQprim(q:Query[R]): SToRsQ = new SToRsQ {
        def apply[A](s:ValSpine[A]):List[R] = s match {
          case ConstrExt(c,i) => List()
          case Apped(f,Typed(x,t)) => mapQprim(q)(f) ::: List(q(t,x))
      }}
      new Query[List[R]] {
        def apply[A](ty:TypeMan[A], a:A):List[R] = mapQprim(q) .apply( ty.toValSpine(a) )
      }
    }
    
    trait Traversal {
      def apply[A](ty:TypeMan[A], a:A):A
    }
    def mapT(t:Traversal):Traversal = {
      trait SToST { def apply[A](s:ValSpine[A]):ValSpine[A] }
      def mapTprim(t:Traversal):SToST = new SToST {
        def apply[A](s:ValSpine[A]):ValSpine[A] = s match {
          case ConstrExt(c,i) => s
          case Apped(f,Typed(x,ty)) => Apped( mapTprim(t)(f)  , Typed(t(ty,x),ty))
        }}
      new Traversal {
        def apply[A](ty:TypeMan[A], a:A):A = (mapTprim(t)(ty.toValSpine(a)) ).buildFromSpine
      }
    }
    
    abstract class OneTraversable[A](self:A)(implicit tyman:TypeMan[A]) {
      def onemapT(t:Traversal):A = mapT(t)(tyman,self)
    }
    
    
    
    def everythingprim[R](q:Query[R]):Query[List[R]] = new Query[List[R]] {
      def apply[A](ty:TypeMan[A],a:A):List[R] = { val onself = List(q(ty,a))
                                                  val onchildren = mapQ(everythingprim(q)) .apply(ty,a)
        onself ::: onchildren.flatten( (x:List[R])=>x)
      }
    }
    def everything[R](op: (R,R)=>R, q:Query[R]):Query[R] = new Query[R]{
      def apply[A](ty:TypeMan[A], a:A):R = { val onself = q(ty,a)
                                             val onchildren = mapQ(everything(op,q)).apply(ty,a)
                                             ( onself /: onchildren )  (op)
                                           }
      
    }
    
    
    def everywhere_bu(t:Traversal):Traversal = new Traversal {
      def apply[A](ty:TypeMan[A], a:A):A =  { val onchildren = mapT(everywhere_bu(t)) .apply(ty,a)
        t(ty,onchildren)
      }
    }
    def everywhere_td(t:Traversal):Traversal = new Traversal {
      def apply[A](ty:TypeMan[A], a:A):A =  { val onchildren = mapT(everywhere_td(t)) .apply(ty, t(ty,a))
        onchildren
      }
    }
    
    
    
    /*
     * Sum reformulated
     */ 
    
    def sum:Query[Int] = {
      val sumQ = new Query[Int] {
        def apply[A](ty:TypeMan[A], a:A):Int = ty match {
          case IntMan => a
          case _ => 0
        }
      }
      everything( (_+_), sumQ)
    }
  
  
  
  
  
  
  

  /*
   * Example Typemans
   */
  
  
  class PrimitiveTypeMan[T](name:String) extends TypeMan[T]{
    def toValSpine(a:T):ValSpine[T] = throw new Exception("not supposed to take valSpine of a "+name+": handle as primitive")
  }

  //need either manual instance or provided through reflection for every datatype
  implicit object CharMan extends TypeMan[Char] {
    def toValSpine(c:Char)= ConstrExt(c, new {val n=c.toString})
  }
  implicit object IntMan extends TypeMan[Int] {
    def toValSpine(i:Int)=ConstrExt(i, new {val n=i.toString})
  }
  case class Tuple2Man[A,B](implicit aman: TypeMan[A], bman: TypeMan[B]) extends TypeMan[Tuple2[A,B]] {
    def toValSpine(p:Tuple2[A,B]) = {val constrf = ConstrExt( (a:A)=>(b:B)=>Tuple2(a,b) , new {val n="Tuple2"})
                                  val awrap = Ty(p._1)
                                  val bwrap = Ty(p._2)
                                  Apped(Apped( constrf
                                             , awrap)
                                       , bwrap)
    }
  }
  case class ListMan[A]()(implicit val view: TypeMan[A] ) extends TypeMan[List[A]] { //self:TypeMan[List[A]] =>
    def toValSpine(l:List[A]):ValSpine[List[A] ] = l match {
      case Nil => ConstrExt[List[A]](Nil, new {val n="Nil"})
      case hd::tl => { val constrf :ValSpine[A=>(List[A]=>List[A])]= ConstrExt[A=>List[A]=>List[A]]( (a:A)=>(as:List[A])=> as, new {val n="List.::"});
                       val hdwrap : Typed[A] = Ty(hd) 
                       val tlwrap = Ty(tl)(ListMan()) //Typed(tl,new ListV()(view))
                       val hdappled :Apped[A, List[A]=>List[A]]  = Apped( constrf,hdwrap)
                       val fullappled:ValSpine[List[A]]         = Apped[List[A],List[A]]     ( hdappled, tlwrap)
                       fullappled
                       Apped     ( Apped( constrf
                                         , hdwrap)
                                 , tlwrap)
                     }
    }
  }
  implicit def List2TypeMan[A](a:A )(implicit view: TypeMan[A]):TypeMan[List[A]] = new ListMan()
  
  

  
  
}

